Supercompiler 1997/SUPERCOMPILER97.iso/Delphi 3.0/DATA.Z/provider.pas

Pascal/Delphi Source File | 1997-01-29 | 5.6 KB | 217 lines

{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{       Custom Provider                                 }
{                                                       }
{       Copyright (c) 1997 Borland International        }
{                                                       }
{*******************************************************}

unit Provider;

interface

uses Windows, ActiveX, SysUtils, ComObj, Classes, StdVcl;

type

{ TCustomProvider }

  TCustomProvider = class;

  TProviderObject = class(TAutoIntfObject, IProvider)
  private
    FProvider: TCustomProvider;
  protected
    procedure CheckProvider;
    { IProvider }
    function Get_Data: OleVariant; safecall;
    function GetMetaData: OleVariant; safecall;
    function GetRecords(Count: Integer; out RecsOut: Integer): OleVariant; safecall;
    function ApplyUpdates(Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant; safecall;
    function DataRequest(Input: OleVariant): OleVariant; safecall;
    function Get_Constraints: WordBool; safecall;
    procedure Set_Constraints(Value: WordBool); safecall;
    procedure Reset; safecall;
  public
    constructor Create(AProvider: TCustomProvider);
    destructor Destroy; override;
  end;

  TCustomProvider = class(TComponent)
  private
    FProviders: TList;
    FConstraints: WordBool;
    procedure AddProvider(AProvider: TProviderObject);
    procedure RemoveProvider(AProvider: TProviderObject);
  protected
    function GetProvider: IProvider; virtual;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Get_Data: OleVariant; virtual;
    function GetMetaData: OleVariant; virtual;
    function GetRecords(Count: Integer; out RecsOut: Integer): OleVariant; virtual;
    function ApplyUpdates(Delta: OleVariant; MaxErrors: Integer;
      out ErrorCount: Integer): OleVariant; virtual; abstract;
    function DataRequest(Input: OleVariant): OleVariant; virtual;
    procedure Reset; virtual;
    property Data: OleVariant read Get_Data;
    property Provider: IProvider read GetProvider;
    property Constraints: WordBool read FConstraints write FConstraints;
  end;

implementation

const
  SProviderInvalid = 'Invalid provider. Provider was freed by the application server';

{ TProviderObject }

constructor TProviderObject.Create(AProvider: TCustomProvider);
var
  StdVcl: ITypeLib;
begin
  OleCheck(LoadRegTypeLib(LIBID_STDVCL, 1, 0, 0, StdVcl));
  inherited Create(StdVcl, IProvider);
  FProvider := AProvider;
  if Assigned(FProvider) then FProvider.AddProvider(Self);
end;

destructor TProviderObject.Destroy;
begin
  if Assigned(FProvider) then FProvider.RemoveProvider(Self);
  inherited Destroy;
end;

procedure TProviderObject.CheckProvider;
begin
  if not Assigned(FProvider) then raise EOleError.Create(SProviderInvalid);
end;

{ TProviderObject.IProvider }

function TProviderObject.ApplyUpdates(Delta: OleVariant; MaxErrors: Integer;
  out ErrorCount: Integer): OleVariant;
begin
  CheckProvider;
  Result := FProvider.ApplyUpdates(Delta, MaxErrors, ErrorCount);
end;

function TProviderObject.Get_Data: OleVariant;
begin
  CheckProvider;
  Result := FProvider.Get_Data;
end;

function TProviderObject.GetMetaData: OleVariant;
begin
  CheckProvider;
  Result := FProvider.GetMetaData;
end;

function TProviderObject.GetRecords(Count: Integer; out RecsOut: Integer): OleVariant;
begin
  CheckProvider;
  Result := FProvider.GetRecords(Count, RecsOut);
end;

function TProviderObject.DataRequest(Input: OleVariant): OleVariant;
begin
  CheckProvider;
  Result := FProvider.DataRequest(Input);
end;

function TProviderObject.Get_Constraints: WordBool; safecall;
begin
  CheckProvider;
  Result := FProvider.Constraints;
end;

procedure TProviderObject.Set_Constraints(Value: WordBool); safecall;
begin
  CheckProvider;
  FProvider.Constraints := Value;
end;

procedure TProviderObject.Reset;
begin
  CheckProvider;
  FProvider.Reset;
end;

{ TCustomProvider }

constructor TCustomProvider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TCustomProvider.Destroy;
var
  I: Integer;
begin
  if FProviders <> nil then
  begin
    for I := 0 to FProviders.Count - 1 do
      TProviderObject(FProviders[I]).FProvider := nil;
    FProviders.Free;
    FProviders := nil;
  end;
  inherited Destroy;
end;

procedure TCustomProvider.AddProvider(AProvider: TProviderObject);
begin
  if FProviders = nil then FProviders := TList.Create;
  FProviders.Add(AProvider);
end;

procedure TCustomProvider.RemoveProvider(AProvider: TProviderObject);
begin
  if FProviders <> nil then
  begin
    FProviders.Remove(AProvider);
    if FProviders.Count = 0 then
    begin
      FProviders.Free;
      FProviders := nil;
    end;
  end;
end;

function TCustomProvider.GetProvider: IProvider;
begin
  Result := TProviderObject.Create(Self);
end;

function TCustomProvider.GetMetaData: OleVariant;
var
  RecsOut: Integer;
begin
  Result := GetRecords(0, RecsOut);
end;

function TCustomProvider.Get_Data: OleVariant;
var
  RecsOut: Integer;
begin
  Result := GetRecords(-1, RecsOut);
end;

function TCustomProvider.GetRecords(Count: Integer; out RecsOut: Integer): OleVariant;
begin
  Result := NULL;
end;

function TCustomProvider.DataRequest(Input: OleVariant): OleVariant;
begin
  Result := NULL;
end;

procedure TCustomProvider.Reset;
begin
end;

end.